home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / dde / odbcncap / module1.bas < prev    next >
BASIC Source File  |  1995-10-26  |  4KB  |  110 lines
  1.  
  2. Sub ODBCBuildParams (parmCDataType As Integer, parmSQLDataType As Integer, parmVariableValue As Variant, parmPrecision As Integer, parmScale As Integer, inIndex As Integer)
  3. If inIndex > 1 Then
  4.     ReDim Preserve aParmList(inIndex)
  5. Else
  6.     If inIndex = 0 Then
  7.         ReDim aParmList(inIndex)
  8.         Exit Sub
  9.     Else
  10.         ReDim aParmList(inIndex)
  11.     End If
  12. End If
  13.  
  14. aParmList(inIndex).nCDataType = parmCDataType
  15. aParmList(inIndex).nSQLDataType = parmSQLDataType
  16. aParmList(inIndex).vVariableValue = parmVariableValue
  17. aParmList(inIndex).nPrecision = parmPrecision
  18. aParmList(inIndex).nScale = parmScale
  19.  
  20. End Sub
  21.  
  22. Function ODBCExecute (hDbc As Long, hStmt As Long, sSourceSQL As String, ParmArray() As ODBCArrayType) As Integer
  23. Dim nStatus As Integer
  24. Dim i As Integer
  25. Dim workString() As String
  26. Dim workLongInteger() As Long
  27. Dim workInteger() As Integer
  28. Dim workSingle() As Single
  29. Dim workDouble() As Double
  30.  
  31. '
  32. ' Hope for the best!
  33. '
  34. ODBCExecute = True
  35.  
  36. If UBound(ParmArray) <> 0 Then
  37.  
  38.     For i = 1 To UBound(ParmArray, 1)
  39.         Select Case VarType(ParmArray(i).vVariableValue)
  40.         Case V_STRING
  41.             ReDim Preserve workString(i)
  42.             workString(i) = ParmArray(i).vVariableValue
  43.         Case V_LONG
  44.             ReDim Preserve workLongInteger(i)
  45.             workLongInteger(i) = ParmArray(i).vVariableValue
  46.         Case V_INTEGER
  47.             ReDim Preserve workInteger(i)
  48.             workInteger(i) = ParmArray(i).vVariableValue
  49.         Case V_DOUBLE
  50.             ReDim Preserve workDouble(i)
  51.             workDouble(i) = ParmArray(i).vVariableValue
  52.         Case V_SINGLE
  53.             ReDim Preserve workSingle(i)
  54.             workSingle(i) = ParmArray(i).vVariableValue
  55.         Case V_DATE
  56.             workString(i) = Format(ParmArray(i).vVariableValue, "Short Date")
  57.         Case Else
  58.             MsgBox "Invalid value for a parameter"
  59.             ODBCExecute = False
  60.             GoTo ODBCExecute_Continue
  61.         End Select
  62.  
  63.         Select Case ParmArray(i).nCDataType
  64.         Case SQL_C_CHAR
  65.             ' Applies to VB strings going to char, varchar and text datatypes.
  66.             nStatus = SQLSetParam(hStmt, i, ParmArray(i).nCDataType, ParmArray(i).nSQLDataType, ParmArray(i).nPrecision, ParmArray(i).nScale, ByVal workString(i), SQL_NTS)
  67.         Case Else
  68.             ' Applies to VB long going to integer datatype
  69.             Select Case VarType(ParmArray(i).vVariableValue)
  70.             Case V_LONG
  71.                 nStatus = SQLSetParam(hStmt, i, ParmArray(i).nCDataType, ParmArray(i).nSQLDataType, ParmArray(i).nPrecision, ParmArray(i).nScale, workLongInteger(i), SQL_NTS)
  72.             Case V_INTEGER
  73.                 nStatus = SQLSetParam(hStmt, i, ParmArray(i).nCDataType, ParmArray(i).nSQLDataType, ParmArray(i).nPrecision, ParmArray(i).nScale, workInteger(i), SQL_NTS)
  74.             Case V_DOUBLE
  75.                 nStatus = SQLSetParam(hStmt, i, ParmArray(i).nCDataType, ParmArray(i).nSQLDataType, ParmArray(i).nPrecision, ParmArray(i).nScale, workDouble(i), SQL_NTS)
  76.             Case V_SINGLE
  77.                 nStatus = SQLSetParam(hStmt, i, ParmArray(i).nCDataType, ParmArray(i).nSQLDataType, ParmArray(i).nPrecision, ParmArray(i).nScale, workSingle(i), SQL_NTS)
  78.             Case Else
  79.                 MsgBox "Invalid value for a parameter"
  80.                 ODBCExecute = False
  81.                 GoTo ODBCExecute_Continue
  82.             End Select
  83.         End Select
  84.         If nStatus = SQL_SUCCESS Then
  85.         '
  86.         ' Continue...
  87.         '
  88.         Else
  89.             If nStatus <> SQL_SUCCESS_WITH_INFO Then
  90.                 DescribeError hDbc, hStmt
  91.                 ODBCExecute = False
  92.                 GoTo ODBCExecute_Continue
  93.             End If
  94.         End If
  95.  
  96.     Next i
  97. End If
  98.  
  99. nStatus = SQLExecDirect(hStmt, sSourceSQL, Len(sSourceSQL))
  100. If nStatus <> SQL_SUCCESS Then '*** SQL Success = 0
  101.     DescribeError hDbc, hStmt
  102.     ODBCExecute = False
  103. End If
  104.  
  105. ODBCExecute_Continue:
  106. Exit Function
  107.  
  108. End Function
  109.  
  110.